home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / 75WPC2LB.SRC < prev    next >
Text File  |  1990-11-04  |  17KB  |  565 lines
  1. ;\|
  2. ;75WPC2LB.SRC     Translated from 75WPC2LB.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;START    04:15:36 PM  21/ 6/90   |
  4. RECALLSX:
  5. define(Z30|A|30||)
  6. define(YES.NO|A|1||)
  7. define(WAIT|N|3||)
  8. define(MEM_AD|A|22||)
  9. define(CHK_FLD|N|8||)
  10. define(NUM_N|N|2||)
  11. define(NUM|A|2||)
  12. define(DATE_A|A|8||)
  13. define(DATE_B|A|10||)
  14. define(TO_DATE|S|8||)
  15. define(SENT_DATE|S|8||)
  16. define(CHK_DATE|S|8||)
  17. define(PUNC2|N|2||)
  18. define(CH_NAME|A|15||)
  19. define(HIS|A|3||)
  20. define(CLIN_DAY|A|25||)
  21. define(CLIN_TIME|A|10||)
  22. define(CNTR|N|2||)
  23. define(FLAG|A|1||)
  24. define(AMOUNTX|N|4||)
  25. define(S10|A|10||)
  26. define(DATECOD|S|8||)
  27. define(CODER|A|5||)
  28. define(C30|A|30||)
  29. define(TM|A|27||4)
  30. define(A30|A|30||)
  31. define(CHOICE|N|1||)
  32. define(TDND|S|8||)
  33. define(DATERP|S|8||)
  34. define(B30|A|30||)
  35. define(S1|A|1||)
  36. define(TD|S|8||)
  37. define(A8|A|8||)
  38. define(B8|A|8||)
  39. define(YES.NO|A|1||)
  40. define(N5|N|5||)
  41. define(D1|A|1||)
  42. define(NY|A|1||)
  43. define(CODEX1|S|8||)
  44. define(CTR|N|2||)
  45. define(DATEN|N|2||)
  46. define(DATEX|S|8||)
  47. define(ARRAY1|A|30||3)
  48. define(ARRAY2|A|22||3)
  49. define(ARRAY3|A|22||3)
  50. define(ARRAY4|A|4||3)
  51. define(ARRAY5|S|8||3)
  52. define(TIT|A|4||)
  53. define(PATIENT1A|A|30||)
  54. define(PUNC1|N|2||)
  55. define(N.2.0.P|N|2||)
  56. define(P.2.0.1|N|2||)
  57. define(P.2.0.2|N|2||)
  58. define(PATIENT2|A|30||)
  59. define(P.2.0.3|N|2||)
  60. define(RECTYPE1|A|4||)
  61. define(RECTYPE2|A|4||)
  62. define(PATIENT1|A|30||)
  63. define(DOB1|D|10||)
  64. define(DOB2|D|10||)
  65. trap(q|g|exit4)
  66. STARTREC:
  67. open(PATIENT||0|FILE_LOCK)
  68. open(GPSETUP||0|)
  69. D1 = ("")
  70. date(TD|G)
  71. YES.NO = ("")
  72. DATEX = (0)
  73. CODEX1 = (0)
  74. NY = ("")
  75. trap(I|G|PRINTSTOP)
  76. trap(S|I)
  77. trap(D|I)
  78. trap(F|I)
  79. trap(R|I)
  80. trap(B|I)
  81. trap(G|I)
  82. trap(H|S|HELP)
  83. trap(M|I)
  84. trap(N|I)
  85. trap(Q|G|MENU)
  86. trap(J|G|LASTSEEN)
  87. goto LASTSEEN
  88. mount(RECALLS|S)
  89. enter(RECTYPE1||||Y|Y|N|||N)
  90. enter(RECTYPE2||||Y|Y|N|||N)
  91. enter(CTR|"123456789"|||N|Y|N|||N)
  92. enter(CODEX1|||RECALLSX|N|Y|N|||N)
  93. DATEXX:
  94. NY = ("")
  95. enter(YES.NO|"YN"|||Y|Y|N|||N)
  96. CODEX1:
  97. RECSTART:
  98. COD.PAT.NAME = ("A")
  99. find(G|COD.PAT.NAME|EXIT|N)
  100. RECTEST:
  101. if COD[CTR] = ("HYS") goto NEXTRECALL
  102. if COD[CTR] = ("VIR") goto NEXTRECALL
  103. if COD[CTR] = ("REF") goto NEXTRECALL
  104. if COD[CTR] = ("MOV") goto NEXTRECALL
  105. if RECTYPE1 <> ("") then if RECTYPE1 > (COD[CTR]) goto NEXTRECALL
  106. if RECTYPE2 <> ("") then if RECTYPE2 < (COD[CTR]) goto NEXTRECALL
  107. if COD.D[CTR] > (CODEX1) goto NEXTRECALL
  108. if COD.D[CTR] = (0) goto NEXTRECALL
  109. RECORD.NUMBER = (COD.REF)
  110. DATECOD = (COD.D[CTR])
  111. CODER = (COD[CTR])
  112. find(M|RECORD.NUMBER|EXIT|)
  113. DATERP = (COD.D[CTR])
  114. if NY = ("") do
  115. {
  116. gosub PRINTRECAL
  117. }
  118. else
  119. {
  120. gosub RECLABPRIN
  121. }
  122. NEXTRECALL:
  123. find(N|RECALLS|EXITX|)
  124. goto RECTEST
  125. MOUNTRECAL:
  126. mount(RPLABELS|R|P)
  127. pchr(P|10)
  128. pchr(P|11)
  129. pchr(P|4)
  130. pchr(P|1)
  131. pset(132|66|60)
  132. trap(I|G|PRINTSTOP)
  133. trap(P|S|RECHEAD)
  134. AMOUNTX = (0)
  135. gosub RECHEAD
  136. ret
  137. PRINTRECAL:
  138. pfmt(18|||N|N|)
  139. AMOUNTX = (AMOUNTX+1)
  140. DATECOD = (0)
  141. CODER = ("")
  142. ret
  143. RECHEAD:
  144. pfmt(16|||N|N|)
  145. pfmt(17|||N|N|)
  146. ret
  147. RECALLS:
  148. trap(P|D)
  149. ptof
  150. if D1 = ("X") then goto RECALLSX
  151. if YES.NO = ("Y") do
  152. {
  153. gosub RECLABS
  154. }
  155. else
  156. {
  157. goto RECALLSX
  158. }
  159. goto RECSTART
  160. TOPOF:
  161. ptof
  162. ret
  163. RECLABS:
  164. NY = ("X")
  165. trap(P|D)
  166. trap(I|S|PRINTSTOP)
  167. pchr(P|4)
  168. mount(NEW|R|P)
  169. pset(50|18|18)
  170. D1 = ("X")
  171. ret
  172. PRINT_LAB:
  173. pblnk(4)
  174. pfmt(1|||N|N|)
  175. pblnk(2)
  176. pfmt(2|||N|N|)
  177. pblnk(2)
  178. pfmt(3|||N|N|)
  179. pblnk(4)
  180. if FLAG = ("X") goto EXIT
  181. ret
  182. CL_ARRAY:
  183. clrmem(ARRAY1|3)
  184. clrmem(ARRAY2|3)
  185. clrmem(ARRAY3|3)
  186. clrmem(ARRAY4|3)
  187. clrmem(ARRAY5|3)
  188. ret
  189. RECLABPRIN:
  190. gosub SEXIST
  191. gosub NEWX
  192. NY = ("X")
  193. DATECOD = (0)
  194. CODER = ("")
  195. CNTR = (CNTR+1)
  196. ARRAY1[CNTR] = (Z30)
  197. ARRAY2[CNTR] = (ADDRESS1)
  198. ARRAY3[CNTR] = (AREA)
  199. ARRAY4[CNTR] = (COD[CTR])
  200. ARRAY5[CNTR] = (COD.D[CTR])
  201. if CNTR = (3) gosub PRINT_LAB
  202. ret
  203. EXITX:
  204. if NY <> ("") do
  205. {
  206. CNTR = (2)
  207. FLAG = ("X")
  208. gosub RECLABPRIN
  209. }
  210. goto RECALLS
  211. REPONLY:
  212. run("REPONLY")
  213. SEXIST:
  214. if SEX = ("M") then TIT = ("Mr.")
  215. if SEX = ("F") do
  216. {
  217. if MARITAL.STATUS = ("M") do
  218. {
  219. TIT = ("Mrs.")
  220. }
  221. else
  222. {
  223. TIT = ("Ms.")
  224. }
  225. }
  226. if SEX = ("") then TIT = ("Ms.")
  227. trim(TIT|T)
  228. ret
  229. NEWX:
  230. NY = (" ")
  231. PATIENT1A = (PATIENT.NAME)
  232. trim(PATIENT1A|T)
  233. PUNC1 =loc(","|PATIENT1A|1||27)
  234. N.2.0.P =siz(A|PATIENT.NAME)
  235. P.2.0.1 = (PUNC1-1)
  236. PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  237. P.2.0.2 = (PUNC1+2)
  238. P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  239. PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  240. trim(PATIENT1|T)
  241. trim(PATIENT2|T)
  242. Z30 = (TIT+PATIENT1+NY+PATIENT2)
  243. ret
  244. CLEARALL:
  245. clr(PATIENT|B)
  246. clr(RECALLS|B)
  247. S1 = ("")
  248. DATEX = (0)
  249. YES.NO = ("")
  250. ret
  251. EXIT:
  252. run("75WPC2")
  253. EXIT1:
  254. run("75WPC2")
  255. PRINTSTOP:
  256. pon(S)
  257. clrlne(1|25)
  258. pmsg("CONTINUE ? (Y/N):"|30|12|N|N|S|)
  259. enter(YES.NO|"YN"||PRINTSTOP|Y|Y|N|48|12|N)
  260. if YES.NO <> ("Y") then run("recmenu")
  261. pon(P)
  262. ret
  263. MENU:
  264. TM[1] = (" 1 - EXIT             01011")
  265. menu(1|20|2|23|0|TM|CHOICE|1|22|MENU||"-------RECALLS--------"|N)
  266. on(CHOICE|G|EXIT1|MENU)
  267. TRACE:
  268. break
  269. ret
  270. FILE_LOCK:
  271. pmsg("FILE PATIENT AND/OR RECALLS IS IN USE - EXIT"|20|24|Y|N|S|)
  272. clrlne(1|24)
  273. run("recmenu")
  274. HELP:
  275. saves(1)
  276. window(1|23|22|78)
  277. pmsg("                                    SMEAR RECALLS"|1|1|N|Y|S|)
  278. pmsg("                                    ============="|1|2|N|Y|S|)
  279. pmsg("1.USE UPDATE PROGRAM AND MAKE SURE ALL WOMEN BETWEEN 33 AND 65 ARE ENTERED"|1|3|N|Y|S|)
  280. pmsg("2.ALL THESE WOMEN MUST HAVE A RECALL DATE."|1|4|N|Y|S|)
  281. pmsg("3.RUN REPORT ONLY TO GET LATEST UPDATE ON TOTAL AT-RISK GROUP"|1|5|N|Y|S|)
  282. pmsg("4.RECALL EVERY MONTH ON THE 16th + A DAY OR TWO"|1|6|N|Y||)
  283. pmsg("5.CHECK OFF AGAINST RECALL LIST. ALL NON-ATTENDERS WILL BE ASKED AGAIN"|1|7|N|Y|S|)
  284. pmsg("6.NON-ATTENDERS WILL BE THOSE WHO ARE MORE THAN ONE MONTH BEHIND"|1|8|N|Y||)
  285. pmsg(""|1|9|N|Y|S|)
  286. pmsg("                                    CODES"|1|10|N|Y|S|)
  287. pmsg("                                    ====="|1|11|N|Y|S|)
  288. pmsg("CODE 1 = SMEARS"|1|12|N|Y|S|)
  289. pmsg("CODE 2 = CONTRACEPTION"|1|13|N|Y|S|)
  290. pmsg("CODE 3 = IMMUNISATION"|1|14|N|Y|S|)
  291. pmsg("CODE 4 = DIABETES"|1|15|N|Y|S|)
  292. pmsg("CODE 5 = EPILEPSY"|1|16|N|Y|S|)
  293. pmsg("CODE 6 = THYROID"|1|17|N|Y|S|)
  294. pmsg("CODE 7 = ANGINA AND HEART DISEASE"|1|18|N|Y|S|)
  295. pmsg("CODE 8 = ASTHMA"|1|19|N|Y|S|)
  296. pmsg("CODE 9 = BP"|1|20|N|Y|S|)
  297. pmsg(""|1|21|Y|N|S|)
  298. redsp(1)
  299. ret
  300. LASTSEEN:
  301. trap(I|S|PRINTSTOP)
  302. trap(J|G|STARTREC)
  303. mount(LABS|S)
  304. MEM_AD = ("1")
  305. enter(MEM_AD||||Y|N|N|||N)
  306. enter(DOB1||||N|N|N|||N)
  307. enter(DOB2||||N|N|N|||N)
  308. SENT_DATE = (TD)
  309. enter(YES.NO|"YN"|||Y|Y|N|||N)
  310. if YES.NO <> ("Y") goto LASTSEEN
  311. gosub RECLABS
  312. ADDRESS1 = (MEM_AD)
  313. find(G|ADDRESS1|EXIT|)
  314. TEST_SEEN:
  315. if DATE.OF.BIRTH < (DOB1) goto NEXT_SEEN
  316. if DATE.OF.BIRTH > (DOB2) goto NEXT_SEEN
  317. gosub PRINT_SEEN
  318. NEXT_SEEN:
  319. find(N|PATIENT|EXITXX|)
  320. pmsg(RECORD.NUMBER|1|1|N|N|S|)
  321. goto TEST_SEEN
  322. PRINT_SEEN:
  323. gosub SEXIST
  324. gosub NEWX
  325. gosub SEEN_PRINT
  326. ret
  327. SEEN_PRINT:
  328. WAIT = (WAIT+1)
  329. if WAIT = (195) do
  330. {
  331. pmsg(WAIT;" PRINTED - CHANGE CARDS AND PRESS RET...";RECORD.NUMBER;"  next"|10|20|Y|N|S|)
  332. WAIT = (0)
  333. }
  334. pblnk(6)
  335. pfmt(1|||N|N|)
  336. pblnk(2)
  337. pfmt(2|||N|N|)
  338. pblnk(2)
  339. pfmt(3|||N|N|)
  340. pblnk(4)
  341. pfmt(4|||N|N|)
  342. ret
  343. DAT_TEST:
  344. goto PRINT_SEEN
  345. EXITXX:
  346. goto EXIT
  347. exit4:
  348. run("recmenu")
  349. \R RPLABELS
  350. &                                      &                                        &
  351. &                                      &                                        &
  352. &                                      &                                        &
  353.  
  354. &    &                                 &    &                                   &    &
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.       &
  362.            &
  363.               &
  364.       &
  365. PATIENT                - RECALL REPORT- &                                        CODE (& )
  366. ------------------------------------------------------------------------------------------
  367. &                             &                     &                      (&    )&         &     [&]
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398. \
  399. ARRAY1[1]
  400. ARRAY1[2]
  401. ARRAY1[3]
  402. ARRAY2[1]
  403. ARRAY2[2]
  404. ARRAY2[3]
  405. ARRAY3[1]
  406. ARRAY3[2]
  407. ARRAY3[3]
  408. ARRAY4[1]
  409. ARRAY5[1]
  410. ARRAY4[2]
  411. ARRAY5[2]
  412. ARRAY4[3]
  413. ARRAY5[3]
  414. Z30
  415. ADDRESS1
  416. AREA
  417. DATERP
  418. TD
  419. CTR
  420. PATIENT.NAME
  421. ADDRESS1
  422. AREA
  423. CODER
  424. DATECOD
  425. AMOUNTX
  426. DOCTOR
  427. \
  428. \SSRECALLS 
  429.                                                                                                 
  430.                                                                                                 
  431.                                                                                                 
  432.                                                   YOU MAY JUMP TO PRINT "NOT SEEN" LABELS       
  433.                                                                                                 
  434.       This will recall all recall code 1 except "HYS;VIR;MOV;REF;ETC"                           
  435.                                                                                                 
  436.    RECALLS                                                       ╔══════════════════════════════
  437. ══════════╗                                      ║                                        ║     
  438.                                  ║  From Code: t t t t  to  Code: t t t t         ║                     
  439.                  ║                                        ║                                     
  440.  ║ Recall code:[ t t]                       ║                                      ║              
  441.                           ║                                      ║ Up to Date: t t t t t t t t          
  442. Labels?: t ║                                      ╚════════════════════════════════════════╝     
  443.                                F1 - Help   "Printer on for labels" Esc - Exit                   
  444.                                                                                                 
  445.                                                                                                 
  446.                                                                                                 
  447.                                                                                                 
  448.                                                                                                 
  449. \
  450. RECTYPE1            4 A 3112
  451. RECTYPE2            4 A 4612
  452. CTR                 2 N 3314
  453. CODEX1              8 S 3116
  454. YES.NO              1 A 5716
  455. \
  456. \STNOTE    
  457.                          RECALLS - WHAT TO DO
  458.                          ====================
  459.  
  460. 1. TO TAG ALL POTENTIAL RECALLS ANSWER RUN RECALLS AT RISK FROM MAIN MENU.
  461.  
  462.   (THIS WILL TAG A GIVEN AGE GROUP WITH CODE <****>)
  463.  
  464. 2. TO UPDATE THE <****> USE EASY SMEAR /IMMUNISATION UPDATE PROGRAM.
  465.  
  466. 3. IF YOU ANSWER NO TO REPORT ONLY YOU WILL PRINT A LIST OF OUTSTANDING
  467.    RECALLS WITH OR WITHOUT LABELS.
  468.  
  469. 6. PRINT OUT THESE AND SEND TO PATIENTS.
  470.  
  471. 7. UPDATE  RESULTS USING EASY RECALL MAINTENANCE
  472.  
  473.         NOTE: THIS PROGRAM WILL ALWAYS PRINT OUT "ALL" OUTSTANDING RECALLS.
  474.  
  475.                           ========================
  476.  
  477.  
  478.  
  479.  
  480.  
  481. \
  482. \
  483. \SSLABS    
  484.                                                                                                 
  485.                                                                                                 
  486.                                                                                                 
  487.                                                                                                 
  488.                                                                                                 
  489.               PRINTS ADDRESSES ON CARDS FOR 75 WELL PERSON CLINIC                               
  490.    ╔═══════════════════════════════════════╗                                       ║ From Addres
  491. s: p p p p p p p p p p p p p p p p p p p p p p   ║                                       ║ From D.o.b  : p p p p p p p p p p eg 
  492. 01/01/1880 ║                                       ║ To D.o.b.   : p p p p p p p p p p eg 01/04/1914 ║    
  493.                                    ║     CONTINUE: p Y/N                    ║                    
  494.                    ╚═══════════════════════════════════════╝                                    
  495.     REQUIRES CARDS IN PRINTER REVERSE SIDE                                                 Esc -
  496.  Exit or stop Print                                                                             
  497.                                                                                                 
  498.                                                                                                 
  499.                                                                                                 
  500.                                                                                                 
  501.                                                                                                 
  502.                                                                                                 
  503.                                                                                                 
  504. \
  505. MEM_AD             22 A 35 9
  506. DOB1               10 D 3510
  507. DOB2               10 D 3511
  508. YES.NO              1 A 3512
  509. \
  510. \R NEW     
  511.         &
  512.            &
  513.                &
  514. -&
  515.  
  516.  
  517.  
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541.  
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558.  
  559. \
  560. Z30
  561. ADDRESS1
  562. AREA
  563. RECORD.NUMBER
  564. \
  565.